REM >DirectorTime:!RunImage

ON ERROR: ON ERROR OFF: ERROR ERR,REPORT$+" at "+STR$ ERL

buffer_size%=1024
DIM buffer% buffer_size%

SYS "OS_GetEnv" TO in$
message$=MID$(in$,INSTR(in$,"-message ")+9)

window%=VAL(FNread("Director$Window"))
icon%=VAL(FNread("Director$Icon"))
buttons%=VAL(FNread("Director$Buttons"))

REM IF window%=0 THEN END

SYS "Wimp_Initialise",200,&4B534154,"Temp" TO ,handle%

CASE buttons% OF
  WHEN -255: REM open
    REM SOUND 1,-15,&5000,1
    VDU 7
    PROCset_message(message$)
  WHEN -254: REM close
    REM SOUND 1,-15,&7000,1
  WHEN -253: REM null
    PROCremove
  WHEN 4,1: REM adjust,select
    IF icon%=0 THEN PROCremove
ENDCASE

SYS "Wimp_CloseDown",handle%,&4B534154

END

DEF PROCremove
  OSCLI"DirectorWindow <Director$WindowName> -remove"
ENDIF

DEF PROCset_message(a$)
  PROCseticontext(window%,1,a$)
ENDPROC

DEF FNread(a$)
  ?buffer%=13
  SYS "XOS_ReadVarVal",a$,buffer%,buffer_size%,0,3 TO ,,read%
  buffer%?read%=13
=$buffer%

DEF FNswi_number(name$)
  SYS "OS_SWINumberFromString",,name$ TO A%
=A%

DEF FNgeticontext(win%,icon%)
LOCAL t$,flags%
 t$=""
 IF icon%>=0 THEN
  buffer%!0=win%
  buffer%!4=icon%
  SYS "Wimp_GetIconState",,buffer%
  flags%=buffer%!24
  IF (flags% AND (1<<0))<>0 THEN
   IF (flags% AND (1<<8))=0 THEN
    t$=FNgetstring(12,buffer%+28)
   ELSE
    t$=FNgetstring(255,buffer%!28)
   ENDIF
  ENDIF
 ENDIF
=t$

REM This gets a control terminated string of maximum length l% from p%

DEF FNgetstring(l%,p%)
LOCAL a$
 a$=""
 WHILE ?p%>=32 AND l%>0
  a$+=CHR$(?p%)
  p%+=1
  l%-=1
 ENDWHILE
=a$

REM This sets the icontext of a given icon

DEF PROCseticontext(win%,icon%,text$)
LOCAL flags%
 buffer%!0=win%
 buffer%!4=icon%
 SYS "Wimp_GetIconState",,buffer%
 flags%=buffer%!24
 IF (flags% AND (1<<0))<>0 THEN
  IF (flags% AND (1<<8))=0 THEN
   IF LEN text$>11 THEN ERROR 1,"String too long for non-indirected icon"
   $(buffer%+28)=text$
  ELSE
   $(buffer%!28)=text$
  ENDIF
  buffer%!8=0
  buffer%!12=0
  SYS "Wimp_SetIconState",,buffer%
 ELSE
  ERROR 1,"Not a text icon"
 ENDIF
ENDPROC
